home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / system / UCAnimatedIcon.pas < prev    next >
Pascal/Delphi Source File  |  1999-01-03  |  3KB  |  101 lines
  1. unit UCAnimatedIcon;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   UCAniIcon;
  8.  
  9. type
  10.     TUCAnimatedIcon = class(TCustomControl)
  11.     private
  12.         { Private declarations }
  13.         fIcon: TAniIcon;
  14.         fAnimate: Boolean;
  15.         procedure SetIcon (Value: TAniIcon);
  16.         procedure SetAnimate (Value: Boolean);
  17.         procedure TimerTick (var Msg: TMessage); message wm_Timer;
  18.     protected
  19.         { Protected declarations }
  20.         procedure Paint; override;
  21.     public
  22.         { Public declarations }
  23.         constructor Create (AOwner: TComponent); override;
  24.         destructor Destroy; override;
  25.     published
  26.         { Published declarations }
  27.         property OnEnter;
  28.         property OnExit;
  29.         property OnKeyDown;
  30.         property OnKeyPress;
  31.         property OnKeyUp;
  32.         property TabOrder;
  33.         property TabStop;
  34.         property Visible;
  35.         property Color;
  36.         property ParentColor;
  37.         property Hint;
  38.         property Icon: TAniIcon read fIcon write SetIcon;
  39.         property Animate: Boolean read fAnimate write SetAnimate default False;
  40.     end;
  41.  
  42. procedure Register;
  43.  
  44. implementation
  45.  
  46. constructor TUCAnimatedIcon.Create (AOwner: TComponent);
  47. begin
  48.     Inherited Create (AOwner);
  49.     fIcon := TAniIcon.Create;
  50.     Width := GetSystemMetrics (sm_cxIcon);
  51.     Height := GetSystemMetrics (sm_cyIcon);
  52. end;
  53.  
  54. destructor TUCAnimatedIcon.Destroy;
  55. begin
  56.     fIcon.Free;
  57.     Inherited Destroy;
  58. end;
  59.  
  60. procedure TUCAnimatedIcon.SetIcon (Value: TAniIcon);
  61. begin
  62.     fIcon.Assign (Value);
  63.     fIcon.BackgroundColor := Color;
  64. end;
  65.  
  66. procedure TUCAnimatedIcon.SetAnimate (Value: Boolean);
  67. begin
  68.     fAnimate := Value;
  69.     if fAnimate then SetTimer (Handle, 1, 50, Nil) else KillTimer (Handle, 1);
  70. end;
  71.  
  72. procedure TUCAnimatedIcon.Paint;
  73. var
  74.     R: TRect;
  75. begin
  76.     if (not fAnimate) and (not fIcon.Empty) then begin
  77.         R := Rect (0, 0, fIcon.Width, fIcon.Height);
  78.         OffsetRect (R, (Width - fIcon.Width) div 2, (Height - fIcon.Height) div 2);
  79.         fIcon.Draw (Canvas, R);
  80.     end;
  81. end;
  82.  
  83. procedure TUCAnimatedIcon.TimerTick (var Msg: TMessage);
  84. var
  85.     R: TRect;
  86. begin
  87.     if not fIcon.Empty then begin
  88.         fIcon.Animate;
  89.         R := Rect (0, 0, fIcon.Width, fIcon.Height);
  90.         OffsetRect (R, (Width - fIcon.Width) div 2, (Height - fIcon.Height) div 2);
  91.         fIcon.Draw (Canvas, R);
  92.     end;
  93. end;
  94.  
  95. procedure Register;
  96. begin
  97.     RegisterComponents('UnCommon', [TUCAnimatedIcon]);
  98. end;
  99.  
  100. end.
  101.